perm filename M1.FRT[M11,LCS] blob sn#398786 filedate 1978-11-24 generic text, type T, neo UTF8
CPASS3     PASS 3 MAIN PROGRAM  
C    *** MUSIC V ***     
      INTEGER PEAK
	DOUBLE PRECISION JFLNM,JTRNS,JBLA
      DIMENSION T(50),TI(50),ITI(50)   
      COMMON I(7500) /P/P(50)/PARM/IP(20)/FINOUT/PEAK,NRSOR,IPEAK
	DATA JTRNS/'TRNS'/,JBLA/'    '/
CC*******      DATA IIIRD/Z5EECE66D/     
CC	DATA IIIRD/      DATA IIIRD/976545367/     
      DATA I/7500*0/,I(4)/12800/
C**************
C     INIALIZATION OF PIECE     
C IIIRD - ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU
	I(7)=32767
	I(7)=I(7)+1
CC      I(7)=IIIRD  
	IP9=IP(9)
C****** SEE BLOCK DATA RE. SCALE FACTORS *********   IP(12)=2**8

      PEAK=0      
      NRSOR=0     
	IPEAK=0
C IPEAK AND PEAK USED TO TYPE OUT AMPL. INFO. LATER.
CC*******    NREAD = 3   
CC*******    NWRITE = 2  
      NREAD=21
C   PDP DSK1=DEV.21
      NWRITE=1
C   PDP DSK=DEV.1
CC      REWIND NREAD
CC      REWIND NWRITE      
      TYPE 401  
	ACCEPT 501,JFLNM,IDSK
C  TYPE <CR> TO GET DEFAULT FILE NAME (TRNS.DAT).
	IF(JFLNM.EQ.JBLA)JFLNM=JTRNS
	CALL OPEN(21,JFLNM,0,'RDO',,,'UNF')
      IF(IDSK.NE.0)GO TO 601
C  OUTPUT IS ALWAYS NAMED 'TEST.DAT' FOR NOW.
	CALL OPEN(23,'TEST',0,'NEW',,,'UNF')
	GO TO 701
C  IF IDSK=0, SAMPLES WILL BE WRITTEN ON DSK (TEST.SND)
CC      IDSK=0
C I(4)=SRATE
C  0=12-BIT
C (4)NCHNS←1 OR 2
601   IDSK=-1
401   FORMAT(' TYPE FILE NAME'/)
501   FORMAT(A4,I)
C**** ABOVE FOR PDP10 IO ********
701   SCLFT=IP(12)
      I(2)=IP(4)  
      MS1=IP(7)   
      MS3=MS1+(IP(8)*IP(9))-1   
      MS2=IP(8)   
      I(4)=IP(3)  
      MOUT=IP(10) 
C     INITIALIZATION OF SECTION 
5     T(1)=0.0    
      DO 220 N1=MS1,MS3,MS2
C INITS POSSIBLE NUM OF NOTES THAT CAN PLAY AT ONCE (27 NOW)
 220  I(N1)=-1    
      DO 221N1=1,IP9      
 221  TI(N1)=90909.    
C     MAIN CARD READING LOOP    
  204 CALL DATA (NREAD)  
CX	TYPE 1204,P(1),T(1)
CX	PAUSE 'CALL DATA'
      IF(P(2)-T(1))200,200,244  
 200  IOP=P(1)    
      IF(IOP)201,201,202 
 201  CALLERROR(1)
      GO TO 204     
 202  IF(IP(1)-IOP)201,203,203  
1203	FORMAT(1X5I/)
1204	FORMAT(1X5F/)
CX203	TYPE 1203,IOP,MS1,MS2,MS3
CX	TYPE 1204,SCLFT
203      GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP    
 11   IVAR=P(3)   
      IVARE=IVAR+I(1)-4  
      DO  297 N1=IVAR,IVARE      
      IVARP=N1-IVAR+4    
 297  I(N1)=P(IVARP)     
      GO TO 204     
 3    IGEN=P(3)   
      IF(IGEN.NE.1)GO TO 282
CCC **** ONLY GEN1,GEN2 IN THIS VERSION  GO TO (281,282,283,284,285),IGEN   
 281  CALLGEN1    
      GO TO 204     
 282  IF(IGEN.GT.2)PAUSE ' ONLY GEN1 AND GEN2 FOR NOW'
      CALLGEN2    
      GO TO 204     
CCC 283  CALLGEN3    
CCC   GO TO 204     
CCC 284  CALLGEN4    
CCC   GO TO 204     
CCC 285  CALLGEN5    
CCC   GO TO 204     
 4    IVAR=P(3)   
      IVARE=IVAR+I(1)-4  
      DO 296N1=IVAR,IVARE 
      IVARP=N1-IVAR+4    
 296  I(N1+100)=P(IVARP)*SCLFT  
      GO TO 204     
    6 CALL FROUT3(IDSK)
      STOP 
C     ENTER NOTE TO BE PLAYED   
 1    DO 230N1=MS1,MS3,MS2
230   IF(I(N1).EQ.-1)GO TO 231      
      CALLERROR(2)
C TOO MANY NOTES(27 LIMIT FOR NOW) TRYING TO PLAY AT ONCE.
CX	TYPE 1230,IP(9)
      GO TO 204     
1230	FORMAT(' TOO MANY NOTES AT ONCE. LIMIT=',I2/)
 231  M1=N1
      M2=N1+I(1)-1
      M3=M2+1     
      M4=N1+IP(8)-1      
      DO 232N1=M1,M2      
      M5=N1-M1+1  
 232  I(N1)=P(M5)*SCLFT  
      I(M1  )=P(3)
      DO 233N1=M3,M4      
 233  I(N1)=0     
      DO 235N1=1,IP9      
      IF(TI(N1)-90909.)235,234,235   
 234  TI(N1)=P(2)+P(4)   
      ITI(N1)=M1  
      GO TO 204     
 235  CONTINUE    
      CALLERROR(3)
      GO TO 204     
C     DEFINE INSTRUMENT  
 2    M1=I(2)     
      M2=IP(5)+IFIX(P(3))
      I(M2)=M1    
  218 CALL DATA (NREAD)  
      IF(I(1)-2)210,210,211     
 210  I(M1)=0     
      I(2)=M1+1   
      GO TO 204     
 211  I(M1)=P(3)  
      M3=I(1)     
      I(M1+1)=M1+M3-1    
      M1=M1+2     
      DO 217N1=4,M3
      M5=P(N1)    
      IF(M5)212,213,213  
 212  IF(M5+100)300,301,301     
 300  I(M1)=-IP(2)+(M5+101)*IP(6)      
      GO TO 216     
 301  I(M1)=-IP(13)+(M5+1)*IP(14)      
      GO TO 216     
 213  IF(M5- 100 )214,214,215   
 214  I(M1)=M5    
      GO TO 216     
 215  I(M1)=M5+26262     
CCC 215  I(M1)=M5+262144    
C****** WHAT DOES THIS BIG NUM.(2**18) DO?? ***********
C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
 216  M1=M1+1     
 217  CONTINUE    
      GO TO 218     
C     PLAY TO ACTION TIME
 244  T(2)=P(2)   
 250  TMIN=90909.      
CX	PAUSE 'LABEL 250'
      IREST=1     
      DO 241N1=1,IP9      
      IF(TMIN-TI(N1))241,241,240
 240  TMIN=TI(N1) 
      MNOTE=N1    
 241  CONTINUE    
      IF(90909.-TMIN)251,251,243     
 243  IF(TMIN-T(2))245,245,246  
 245  T(3)=TMIN   
      GO TO 260     
 246  T(3)=T(2)   
      GO TO 260     
 247  IF(T(1)-T(2))249,200,200  
 249  TI(MNOTE)=90909. 
      M2=ITI(MNOTE)      
      I(M2)=-1    
      GO TO 250     
C     SETUP REST  
 251  T(3)=T(2)   
      IREST=2     
      GO TO 260     
C     PLAY 
 260  ISAM=(T(3)-T(1))*FLOAT(I(4))+.5  
      T(1)=T(3)   
      IF(ISAM)247,247,266
 266  IF(ISAM-IP(14))262,262,263
 262  I(5)=ISAM   
      ISAM=0      
      GO TO 264     
 263  I(5)=IP(14) 
      ISAM=ISAM-IP(14)   
 264  IF(I(8))290,290,291
 290  M3=MOUT+I(5)-1     
      MSAMP=I(5)  
      GO TO 292     
 291  M3=MOUT+(2*I(5))-1 
      MSAMP=2*I(5)
 292  DO 267N1=MOUT,M3    
 267  I(N1)=0     
      GO TO (268,265),IREST
 268  DO 270NS1=MS1,MS3,MS2      
      IF(I(NS1)+1)271,270,271   
C     GO THROUGH UNIT GENERATORS IN INSTRUMENT
 271  I(3)=NS1    
      IGEN=IP(5)+I(NS1)  
      IGEN=I(IGEN)
 272  I(6)=IGEN   
CC*****    IF(I(IGEN)-101)293,294,294
CC***** 293  CALLSAMGEN(I)      
C**** ABOVE FOR MACHINE LANG. UNIT GENERATORS *******
CC*****      GO TO 295     
 294  CALLFORSAM  
 295  IGEN=I(IGEN+1)     
      IF(I(IGEN))270,270,272    
 270  CONTINUE    
 265  CALL SAMOUT(IDSK ,MSAMP)
      IF(ISAM)247,247,266
      END